home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_FileRunner.idb / usr / freeware / lib / FileRunner2.5 / http.tcl.z / http.tcl
Encoding:
Text File  |  1999-01-26  |  4.9 KB  |  188 lines
  1.  
  2. proc HTTP_Get { URL filename } {
  3.   set r [HTTP_Config]
  4.   if {$r} { 
  5.     return
  6.   }
  7.   HTTP_Get_ $URL $filename 0
  8. }
  9.  
  10. proc HTTP_Get_ { URL filename iter } {
  11.   global glob
  12.  
  13.   set r [catch {open $filename w} fid]
  14.   if {$r} {
  15.     PopError $fid
  16.     return
  17.   }
  18.  
  19.   fconfigure $fid -translation binary
  20.  
  21.   set glob(http,filename) $filename
  22.   set glob(http,fid) $fid
  23.  
  24.   LogStatusOnly "Transfer $filename : Contacting..."
  25.  
  26.   set glob(http,tl) {}
  27.   for {set i 0} {$i < 30} {incr i} {
  28.     lappend glob(http,tl) {0 -1}
  29.   }
  30.   set glob(http,chunk) 1
  31.  
  32.   set oldicon [wm iconname .]
  33.   set glob(http,t_one) [ClockMilliSeconds]
  34.   set time1 [clock seconds]
  35.   set time1_ms [ClockMilliSeconds]
  36.   set r [catch {::http::geturl $URL -handler HTTP_Handler} token]
  37.   set time2 [clock seconds]
  38.   set time2_ms [ClockMilliSeconds]
  39.   close $fid
  40.   wm iconname . $oldicon
  41.   if {$r} {
  42.     PopError $token
  43.     return
  44.   }
  45.  
  46.   upvar #0 $token state
  47.  
  48. #  puts "Metadata:"
  49. #  foreach {name value} $state(meta) {
  50. #    puts [format "%s %s" $name: $value]
  51. #  }
  52.  
  53.   foreach {name value} $state(meta) {
  54.     if {[regexp -nocase ^location$ $name]} {
  55.       # Handle URL redirects
  56.       # puts "Redirect: Location: $value"
  57.       incr iter
  58.       if {$iter > 10} {
  59.         PopError "Maximum number of HTTP redirects reached. Loop suspected..."
  60.         return
  61.       }
  62.       HTTP_Get_ [string trim $value] $filename $iter
  63.       return 
  64.     }
  65.   }
  66.  
  67.   if {$state(totalsize) != 0} {
  68.     set total $state(totalsize)
  69.     if {$state(currentsize) != $state(totalsize)} {
  70.       PopWarn "Source $URL and destination $filename are not the same length"
  71.     }
  72.   } else {
  73.     set total ?
  74.   }
  75.   
  76.   if {($time2_ms - $time1_ms) != 0} {
  77.     if {($time2 - $time1) < 1000} {
  78.       set diff [expr ($time2_ms - $time1_ms)/1000.0]
  79.     } else {
  80.       set diff [expr $time2 - $time1]
  81.     }
  82.     set speed [format "%.2f" [expr $state(currentsize)/(1024.0 * $diff)]]
  83.   } else {
  84.     set speed ?
  85.   }
  86.   Log "Transfer $filename : $state(currentsize) / $total bytes -- done ($speed kB/s)"
  87.   LogSilent "Transfer $URL to $filename : $state(currentsize) / $total bytes -- done ($speed kB/s)"
  88. }
  89.  
  90.  
  91. proc HTTP_Config {} {
  92.   global config
  93.   if {$config(http,proxy) != ""} {
  94.     set r [regexp {(.*):([0-9]*)} $config(http,proxy) match host port]
  95.     if {!$r} {
  96.       PopError "Cannot parse $config(http,proxy) as proxyhost:port"
  97.       return 1
  98.     }
  99.     ::http::config -proxyhost $host -proxyport $port
  100.   }
  101.   return 0
  102. }
  103.  
  104. proc HTTP_Handler { socket token } {
  105.   global glob config
  106.   upvar #0 $token state
  107.   set chunksize 4096
  108.   set goal_upd_length 2000
  109.   # That's 2000 milliseconds, by the way...
  110.  
  111.   if {[fconfigure $socket -translation] != "binary"} {
  112.     fconfigure $socket -translation binary
  113.   }
  114.   set size $state(currentsize)
  115.  
  116.   set timesum 0.0
  117.   set bytesum 0
  118.   foreach tli $glob(http,tl) {
  119.     if { [lindex $tli 1] != -1 } {
  120.       set timesum [expr $timesum + [lindex $tli 0]]
  121.       incr bytesum [lindex $tli 1]
  122.     }
  123.   }
  124.   if { $timesum <= 0.0 } { set timesum 1.0 }
  125.   set speed [format "%.2f" [expr ($bytesum / ($timesum / 1000.0)) / 1024.0]]
  126.   set speed_Bps [expr ($bytesum / ($timesum / 1000.0))]
  127.   set eta "?"
  128.   set eta_abs "?"
  129.   if {$speed_Bps > 0} {
  130.     set tmp [format "%.0f" [expr ($state(totalsize) - $size) / $speed_Bps]]
  131.     if { $tmp >= 0 } { 
  132.       set eta [format "%02d:%02d" [expr $tmp / 60] [expr $tmp % 60]] 
  133.       if { $config(dateformat) == "yymmdd" } {
  134.         set tmp_date "%y%m%d "
  135.       } else {
  136.         set tmp_date "%y%m%d "
  137.       } 
  138.       set tmp_s [clock seconds]
  139.       if { [clock format [expr $tmp_s + $tmp] -format "%y%m%d"] == [clock format $tmp_s -format "%y%m%d"] } {
  140.         set tmp_date ""
  141.       }
  142.       set eta_abs [clock format [expr $tmp_s + $tmp] -format "$tmp_date%R"]
  143.     }
  144.   }
  145.   if {$state(totalsize) > 0} {
  146.     LogStatusOnly "Transfer $glob(http,filename) : $size / $state(totalsize) bytes ($speed kB/s, ETA $eta $eta_abs)"
  147.   } else {
  148.     LogStatusOnly "Transfer $glob(http,filename) : $size bytes ($speed kB/s)"
  149.   }
  150.   wm iconname . "$eta $eta_abs $glob(http,filename)"
  151.   update idletasks
  152. #  if { $glob(abortcmd) } {
  153. #    set glob(abortcmd) 0
  154. #    close $socket
  155. #    error "Transfer aborted"
  156. #  }
  157.   set i [fcopy $socket $glob(http,fid) -size [expr $glob(http,chunk) * $chunksize]]
  158.   set glob(http,t_two) [ClockMilliSeconds]
  159.   set t [expr $glob(http,t_two) - $glob(http,t_one)]
  160.   if {$t < 0} {
  161.     set t 0
  162.   }
  163.   set glob(http,t_one) $glob(http,t_two)
  164.   if {$i == 0} {
  165.     return 0
  166.   }
  167.   lappend glob(http,tl) "$t [expr $glob(http,chunk) * $chunksize]"
  168.   set glob(http,tl) [lrange $glob(http,tl) 1 end]
  169.   set glob(http,oldchunk) $glob(http,chunk)
  170.   if {$t == 0} {
  171.     set glob(http,chunk) [expr 2 * $glob(http,oldchunk)]
  172.   } else {
  173.     set glob(http,chunk) [expr int(($glob(http,oldchunk) * $goal_upd_length) / $t)]
  174.   }
  175.   set glob(http,chunk) [Clamp [expr $glob(http,oldchunk) / 2] $glob(http,chunk) [expr 2 * $glob(http,oldchunk)]]
  176.   set glob(http,chunk) [Clamp 1 $glob(http,chunk) 900]
  177.  
  178.   return $i
  179. }
  180.  
  181.  
  182. proc Clamp { min x max } {
  183.   if { $x < $min } { set x $min }
  184.   if { $x > $max } { set x $max }
  185.   return $x
  186. }
  187.  
  188.